;;;; Copyright 2009 Peter von Etter

;;;; This file is part of Autoproject

;;;; Autoproject is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation, either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; Autoproject is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with Autoproject.  If not, see
;;;; <http://www.gnu.org/licenses/>.

;; This file depends on CLSQL

(in-package :autoproject.crud)

#+test
(defpackage :clsql)

(defclass clsql-db-adapter (db-adapter) 
  ((db-spec :accessor get-db-spec :initarg :db-spec)
   (db-type :accessor get-db-type :initarg :db-type)))

(defvar *clsql-db-adapter* nil)

(defmethod call-with-db ((db-adapter clsql-db-adapter) fn)
  (if (eq db-adapter *clsql-db-adapter*) ;; ?
      (funcall fn)
      (let ((*clsql-db-adapter* db-adapter))
        (clsql::with-database (clsql::*default-database* 
                               (get-db-spec db-adapter)
                               :if-exists :old
                               :database-type (get-db-type db-adapter)
                               :pool t)
          (funcall fn)))))

(defmethod call-with-transaction ((db-adapter clsql-db-adapter) fn)
  (if (clsql::in-transaction-p)
      (funcall fn)
      (clsql::with-transaction ()
        (funcall fn))))

(defmethod db-query ((db-adapter clsql-db-adapter) query)
  (clsql::query query))

(defmethod db-execute ((db-adapter clsql-db-adapter) statement)
  (clsql::execute-command statement))

(defmethod get-last-id ((db-adapter clsql-db-adapter))
  (case (get-db-type db-adapter)
    (:mysql (caar (clsql::query "select last_insert_id()")))
    (t nil)))

;; Optional
(defmethod read-database-tables ((db-adapter clsql-db-adapter))
  (call-with-db 
   db-adapter
   (lambda ()
     (let* ((tables (append (clsql::list-tables) (clsql::list-views)))
            (fields (mapcar #'clsql::list-attributes tables)))
       (values tables fields)))))


;; Adapters can define this for convenience
(defmethod make-crud (crud-class (db-adapter (eql 'clsql-db-adapter))
                      &rest rest)
  "REST should contain db-type and db-spec."
  (destructuring-bind (db-type db-spec) rest
    (let ((a (make-instance db-adapter 
                            :db-type db-type
                            :db-spec db-spec)))
      (make-crud crud-class a))))

(defmethod make-crud (crud-class (db-adapter clsql-db-adapter)
                      &rest rest)
  "REST should contain db-type and db-spec."
  (declare (ignore rest))
  (make-instance crud-class :db-adapter db-adapter))


